home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu485.dms / pu485.adf / dp.bas < prev    next >
BASIC Source File  |  1977-12-31  |  5KB  |  202 lines
  1. CLS :x=320:y=100:x1=320:y1=100 :s=1:vol=255:dur=1:f=500:t=1500 :o=1:sp=1
  2. WIDTH 80
  3. PRINT "please wait  loading libraries ..."
  4. a$="zthank you !;^;#":gosub draw
  5. a$="#":gosub draw
  6.  
  7.  
  8. 'draw/ play emuator 1.05  25 apr 89  (C) 1989 Wonder-Soft. 
  9. 'Written By David Browder
  10. 'Hisoft or amiga basic 
  11.  
  12.  
  13.  
  14.  
  15. a$="bm300,050;d30;r30;u30;l30;e15;f15;bl18;bd19;d10;r10;u10;l10;":gosub draw
  16.  
  17.  
  18. a$="zplease press any key now .because we are finished drawing our little house;t1;l5;s0;c;d;e;f;g;s1;c;d;e;f;g;":gosub play
  19.  
  20.  
  21.  
  22.     
  23.  
  24. end
  25.  
  26.   
  27. '********************************************************************
  28. END
  29. draw:
  30. IF a$="" THEN RETURN
  31. lp=1:d$=""
  32. parser1:
  33. IF lp>LEN (a$) THEN IF d$<>"" THEN GOSUB draw1:RETURN ELSE RETURN
  34.  IF MID$(a$,lp,1)=";"THEN lp=lp+1:GOSUB draw1 
  35. d$=d$+MID$(a$,lp,1):lp=lp+1
  36. GOTO parser1
  37.  
  38.  draw1:
  39.  IF d$=";" OR d$="" THEN RETURN
  40.  IF LEFT$ (d$,1)="b" THEN blank$="y":d$=RIGHT$(d$,LEN(d$)-1)
  41.  IF LEFT$(d$,1) ="n" THEN nu$="y":   d$=RIGHT$(d$,LEN(d$)-1)
  42.  IF LEFT$(d$,1)="m" THEN GOSUB move :d$="":RETURN
  43.  IF LEFT$ (d$,1)="r" THEN GOSUB right:d$="":RETURN
  44.  IF LEFT$(d$,1)="l" THEN GOSUB left:RETURN
  45.  IF LEFT$(d$,1)="u" THEN GOSUB up:RETURN
  46.  IF LEFT$ (d$,1)="d" THEN GOSUB down: RETURN
  47.  IF LEFT$ (d$,1)="e" THEN GOSUB eeee: RETURN
  48.  IF LEFT$ (d$,1)="f" THEN GOSUB ffff: RETURN
  49.  IF LEFT$ (d$,1)="g" THEN GOSUB gggg: RETURN
  50.  IF LEFT$ (d$,1)="h" THEN GOSUB hhhh: RETURN
  51.  IF LEFT$ (d$,1)="s" THEN GOSUB size:RETURN
  52.  IF LEFT$ (d$,1)="c" THEN GOSUB colr:RETURN
  53.  IF LEFT$(d$,1)="z" THEN GOSUB talk:RETURN
  54.  IF LEFT$ (d$,1)="#" then PRINT "DRAW EMULATOR version 1.05 (c) 1989 Wonder-Soft ":RETURN
  55.  IF LEFT$ (d$,1)="a" THEN PRINT "ANGLE NOT YET SUPPORTED , SORRY " : RETURN
  56.  if left$ (d$,1)="^" then cls : return
  57.  
  58.  PRINT "draw error in > ";d$:END
  59. RETURN
  60.  move:
  61.  d$=RIGHT$(d$,LEN(d$)-1)
  62.  IF LEN (d$)<>7 THEN PRINT "DRAW ERROR IN MOVE STATEMENT";d$:END
  63.  
  64.  IF MID$(d$,4,1)<>"," THEN PRINT "*** BAD X,Y in DRAW ***":END
  65.  v$=LEFT$(d$,3):x1=VAL(v$):v$=RIGHT$(d$,3):y1=VAL(v$) :x=x1:y=y1
  66.  GOSUB plot:RETURN
  67.  plot:
  68.  
  69.  
  70.   IF x<0 THEN x=0
  71.   IF x> 639 THEN x=639
  72.   IF y<0 THEN y=0
  73.   IF y>200 THEN y=200
  74.  IF blank$="y" THEN blank$="": x=x1:y=y1:d$="": RETURN
  75.  LINE (x,y)-(x1,y1)
  76.   IF nu$="y" THEN nu$="":x1=x:y1=y: d$="": RETURN   
  77.  d$="":x=x1:y=y1
  78.  RETURN
  79.   right:
  80.   v=VAL(RIGHT$(d$,LEN(d$)-1 )):x1=x1+(v*s) :GOSUB plot
  81.   RETURN
  82.  left:
  83.  v=VAL (RIGHT$(d$,LEN(d$)-1 )):x1=x1-(v*s) :GOSUB plot
  84.  RETURN
  85.   up:
  86.  v=VAL (RIGHT$(d$,LEN(d$)-1 )):y1=y1-(v*s) :GOSUB plot
  87.  RETURN
  88.   down:
  89.  v=VAL (RIGHT$(d$,LEN(d$)-1 )):y1=y1+(v*s) :GOSUB plot
  90.  RETURN
  91.  eeee:
  92.  v=VAL (RIGHT$(d$,LEN(d$)-1 )):y1=y1-(v*s):x1=x1+(v*s):GOSUB plot
  93.  RETURN
  94.   ffff:
  95.  v=VAL (RIGHT$(d$,LEN(d$)-1 )):y1=y1+(v*s):x1=x1+(v*s):GOSUB plot
  96.  RETURN
  97.   gggg:
  98.  v=VAL (RIGHT$(d$,LEN(d$)-1 )):y1=y1+(v*s):x1=x1-(v*s):GOSUB plot
  99.  RETURN
  100.    hhhh:
  101.  v=VAL (RIGHT$(d$,LEN(d$)-1 )):y1=y1-(v*s):x1=x1-(v*s):GOSUB plot
  102.  RETURN
  103.  size:
  104.  s=VAL (RIGHT$(d$,LEN(d$)-1 )):d$=""
  105.  IF s=0 THEN s=1
  106.  RETURN
  107. colr:
  108.  cc$=RIGHT$(d$,LEN(d$)-1):x2 =VAL (cc$)
  109. IF x2<0 THEN x2=0
  110. IF x2>32  THEN x2=32
  111. COLOR x2:d$="" :cc$=""
  112. RETURN
  113.  
  114.  END
  115.  
  116. play:
  117. IF a$="" THEN RETURN
  118. lp=1:d$=""
  119. loopa:
  120. IF lp>LEN (a$) THEN IF d$<>"" THEN GOSUB play1:RETURN ELSE   RETURN
  121.  IF MID$(a$,lp,1)=";"THEN lp=lp+1:GOSUB play1
  122.  
  123. d$=d$+MID$(a$,lp,1):lp=lp+1
  124. GOTO loopa
  125.  
  126. play1:
  127. IF LEFT$(d$,1)="v" THEN GOSUB volume:d$="":RETURN
  128. IF LEFT$(d$,1)="p" THEN GOSUB pause:RETURN
  129. IF LEFT$(d$,1)="l" THEN GOSUB note:RETURN
  130. IF LEFT$(d$,1)="o" THEN GOSUB octive :RETURN
  131. IF d$="a" THEN f=440:GOSUB music:RETURN
  132. IF d$="b" THEN f=493 :GOSUB music:RETURN
  133. IF d$="c" THEN f=523.25:GOSUB music:RETURN
  134. IF d$="d" THEN f=587.33:GOSUB music:RETURN
  135. IF d$="e" THEN f=659.26:GOSUB music:RETURN
  136. IF d$="f" THEN f=701:GOSUB music: RETURN
  137. IF d$="g" THEN f=783.99:GOSUB music: RETURN
  138. IF LEFT$(d$,1)="s" THEN GOSUB speaker :RETURN
  139. IF LEFT$(d$,1)="t" THEN GOSUB temp :RETURN
  140. IF LEFT$(d$,1)="z" THEN GOSUB talk :RETURN
  141. IF LEFT$(d$,1)="#" then PRINT "Play Emulator Version 1.05 (C) 1989 Wonder-Soft":RETURN
  142.  
  143.  PRINT "*** play error *** > ";d$:END
  144.  
  145. RETURN
  146.  
  147.  
  148. music:
  149. SOUND f*o,dur,vol,sp
  150. FOR tempo=1 TO t:NEXT
  151.  d$=""
  152. RETURN
  153.  
  154. volume:
  155. vol=VAL(RIGHT$(d$,LEN(d$)-1))
  156. IF vol>255 THEN vol=255
  157. IF vol<0 THEN vol =0
  158. d$="":RETURN
  159.  
  160.  
  161.  pause:
  162.  delay=VAL(RIGHT$(d$,LEN(d$)-1))
  163.  FOR xza =1 TO delay*150:NEXT
  164.  d$=""
  165.  RETURN
  166.  
  167.  
  168.  note:
  169.  dur =VAL (RIGHT$(d$,LEN(d$)-1)) 
  170.   IF dur<1 THEN dur=1
  171.   IF dur>77 THEN dur=77
  172.  d$="":RETURN
  173.  
  174.   octive:
  175.   o=VAL(RIGHT$(d$,LEN(d$)-1))
  176.   IF o<0 THEN o=0
  177.   IF o>12 THEN o=12
  178.   d$="":RETURN
  179.   
  180.   speaker:
  181.   sp=VAL(RIGHT$(d$,LEN(d$)-1))
  182.   IF sp<0 THEN sp=0
  183.   IF sp>3 THEN sp=3
  184.   d$=""
  185.   RETURN
  186.    
  187.    temp:
  188.    t=VAL(RIGHT$(d$,LEN(d$)-1))
  189.    IF t >5000 THEN t=5000
  190.    IF t <1 THEN t=1
  191.    d$=""
  192.    RETURN
  193.  
  194.  
  195. talk:
  196. z$=RIGHT$(d$,LEN(d$)-1)
  197.  
  198. SAY TRANSLATE$(z$)
  199. d$=""
  200. RETURN
  201.    
  202.